home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MATH
/
PASCMP
/
PASCMPLX.ASM
< prev
next >
Wrap
Assembly Source File
|
1994-06-29
|
24KB
|
964 lines
TITLE PasCmplx
;Complex mathematics unit for Borland Pascal
;(c)1994 by Alex Klimovitski
;
;Assembler routines for PASCMPLX.PAS Borland Pascal Unit.
;
;* All routines return complex or double values in register ST
; of numeric coprocessor.
;
;* All routines don't left anything else in the 80x87 stack.
;
;* They use maximally 6 80x87 registers (ST(0)..ST(5))
;
;* All complex parameters must be in packed complex format as defined
; below.
;
;* All complex values are returned in packed complex format.
;
;* NOTE: to use this unit with 8087 coprocessor,
; replace "P286" instructions with "P8086",
; set cxx87Min (below) to 1 end recompile the unit.
;
;* Complex number format in 80x87:
; msb lsb
; +--+--+--+--+--+--+--+--+--+--+
; ST(i): | I m - p a r t |
; +--+--+--+--+--+--+--+--+--+--+
; ST(i+1): | R e - p a r t |
; +--+--+--+--+--+--+--+--+--+--+
;
;* Packed complex number format in 80x87:
; msb lsb
; +--+--+--+--+--+--+--+--+--+--+
; ST(i): | Im-part | Re-part |
; +--+--+--+--+--+--+--+--+--+--+
;
;* Packed complex number format in memory:
; msb lsb
; +--+--+--+--+--+--+--+--+
; | Im-part | Re-part |
; +--+--+--+--+--+--+--+--+
MODEL LARGE,PASCAL
LOCALS
PUBLIC CTest87, CInit,\
Cmplx, Conjug, CReal, CImag, Conjug,\
CAdd, CSub, CMul, CDiv, C1Z,\
CAbs, CArg, _CExp2, _CExp3, _CExpR, CExp, CLn,\
CPow, CIPow, CRPow,\
CSinR, CCosR, CSinCosR,\
CTest, CTestR, CCheck, CCheckR
EXTRN Sin, Cos ;used only for 80287
DATASEG
EXTRN Cj:QWORD, C1:QWORD
DB 'PasCmplxMath (c)1994 Alex K.'
;80x87 register state codes
ZERM EQU 0 ;-0
ZERP EQU 1 ;+0
NORM EQU 2 ;normalized < 0
NORP EQU 3 ;normalized > 0
INFM EQU 4 ;-infinity
INFP EQU 5 ;+infinity
UNNM EQU 6 ;-unnormalized
UNNP EQU 7 ;+unnormalized
DENM EQU 8 ;-denormalized
DENP EQU 9 ;+denormalized
NANM EQU 10 ;-not-a-number
NANP EQU 11 ;+not-a-number
EMPT EQU 12 ;empty
OK87 EQU 03h ;80x87 register Ok mask
;80x87 register state table
cxCTable DB UNNP, NANP, UNNM, NANM
DB NORP, INFP, NORM, INFM
DB ZERP, EMPT, ZERM, EMPT
DB DENP, EMPT, DENM, EMPT
UDATASEG
cxx87 DW ? ;80x87 flag: 0=none, 1=8087, 2=80287, 3=80387 and higher
cxx87Min EQU 2 ;minimal 80x87 required
cxPI2 DQ ? ;pi/2
cxPI4 DQ ? ;pi/4
CODESEG
cxINIT MACRO ;initialize 80x87
FINIT
ENDM
cxLD4 MACRO Z ;packed complex Z -> complex in 80x87
FLD DWORD PTR Z
FLD DWORD PTR Z + 4
ENDM
cxSTP4 MACRO Z ;complex in 80x87 -> packed complex Z
FSTP DWORD PTR Z + 4
FSTP DWORD PTR Z
ENDM
cxCONV4 MACRO Z ;complex in 80x87 -> packed complex in 80x87
cxSTP4 Z
FLD QWORD PTR Z
ENDM
cxCONV8 MACRO Z ;packed complex in 80x87 -> complex in 80x87
FSTP QWORD PTR Z
cxLD4 Z
ENDM
cxTST MACRO ;compare real in ST(0) with 0
FTST
FSTSW AX
SAHF
ENDM
cxCMP MACRO ;compare reals in ST(0) and ST(1)
FCOM
FSTSW AX
SAHF
ENDM
cxLDj MACRO ;load complex i
FLDZ
FLD1
ENDM
cxLD1 MACRO ;load complex 1
FLD1
FLDZ
ENDM
cxLD0 MACRO ;load complex 0
FLDZ
FLDZ
ENDM
cxCNJG MACRO ;z = conjug z
cxTST
JZ @@1
FCHS
@@1:
ENDM
cxADD MACRO ;z + p
FADDP ST(2),ST
FADDP ST(2),ST
ENDM
cxSUB MACRO ;z - p
FSUBP ST(2),ST
FSUBP ST(2),ST
ENDM
cxMUL MACRO ;z * p: Re = ac - bd, Im = ad + bc
FLD ST ;b
FLD ST(2) ;a
FMUL ST,ST(5) ;ac
FXCH
FMUL ST,ST(4) ;bd
FSUB ;ac - bd = Re
FXCH ST(2) ;a
FMULP ST(3),ST ;(3) = ad; b
FMULP ST(3),ST ;(3) = bc; Re
FXCH ST(2) ;bc
FADD ;ad + bc = Im
ENDM
cxDIV MACRO ;z/p: Re = (a + d/c * b) / (c + d/c * d),
LOCAL @@1, @@2 ; Im = (b - d/c * a) / (c + d/c * d)
FLD ST(1) ;c
cxTST
JNZ @@1
;c=0
FSTP ST ;d
FDIV ST(3),ST ;(3) = a/d
FDIVP ST(2),ST ;(1) = b/d; c
FSTP ST ;b/d
FXCH ;a/d
FCHS ;-a/d
JMP SHORT @@2
@@1:
FDIVR ST,ST(1) ;d/c
FMUL ST(1),ST ;(1) = d * d/c; d/c
FLD ST ;d/c
FMUL ST,ST(5) ;d/c * a
FXCH ;d/c
FMUL ST,ST(4) ;d/c * b
FADDP ST(5),ST ;(4) = a + d/c * b; d/c * a
FSUBP ST(3),ST ;(2) = b - d/c * a; d/c * d
FADD ;c + d/c * d
FDIV ST(2),ST ;(2) = (a + d/c * b) / (c + d/c * d)
FDIV
@@2:
ENDM
cxABS MACRO ;abs(z)
FMUL ST,ST
FXCH
FMUL ST,ST
FADD
FSQRT
ENDM
cx1Z MACRO ;1/z
FLD ST(1)
FLD ST(1)
cxABS
FDIV ST(2),ST
FDIV
ENDM
cxARG MACRO ;arg z
LOCAL @@1, @@2, @@3, @@4, @@aGE0, @@bGE0, @@00, @@aLTb, @@aGTb, @@bWasLT0
cxTST ;b >= 0?
JGE @@bGE0
FCHS ;b := -b
MOV BL,1
JMP SHORT @@1
@@bGE0:
XOR BL,BL
@@1: ;a
FXCH ;a >= 0?
cxTST
JGE @@aGE0
FCHS ;a := - a;
MOV DL,1
JMP SHORT @@2
@@aGE0:
XOR DL,DL
@@2:
cxCMP ;a > b?
JL @@aLTb
JG @@aGTb
;@@aEQb:
cxTST
FCOMPP
JZ @@00
FLD cxPI4
JMP SHORT @@3
@@00:
FLDZ
JMP SHORT @@4
@@aLTb:
FXCH
FPATAN
FLD QWORD PTR cxPI2
FSUBR
JMP SHORT @@3
@@aGTb:
FPATAN
@@3:
AND DL,DL ;a >= 0?
JZ @@4 ;yes
;@@aWasLT0:
FLDPI
AND BL,BL ;b >= 0?
JNZ @@bWasLT0 ;no
;@@bWasGE0:
FSUBR
JMP SHORT @@4
@@bWasLT0:
FSUB
@@4:
ENDM
cx2X MACRO ;2^x
LOCAL @@1, @@2, @@fGE0, @@iEQ0
FLD ST
FRNDINT ;i = [x]
FSUB ST(1),ST ;(1) = f = x - i
FXCH
cxTST
JGE @@fGE0
;@@fLT0:
FCHS
F2XM1
FLD ST
FLD1
FADD
FDIV
FCHS
JMP SHORT @@1
@@fGE0:
F2XM1
@@1:
FLD1
FADD ;2^f
FXCH ;i
cxTST
JZ @@iEQ0
FXCH
FSCALE
FXCH ;i
@@iEQ0:
FSTP ST ;2^x
@@2:
ENDM
cxEXPR MACRO ;e^x
FLDL2E
FMUL
cx2X
ENDM
cxPOWR MACRO ;x^y
FYL2X
cx2X
ENDM
cxEXP3 MACRO ;e^z
FSINCOS ;cos b
FXCH ST(2) ;a
cxEXPR ;e^a
FMUL ST(2),ST
FMUL
ENDM
cxLNR MACRO ;ln x
FLDLN2
FXCH
FYL2X
ENDM
cxEXAM MACRO
LOCAL @@1, @@MaskC3, @@MaskST1, @@MaskC
@@MaskC3 EQU 40h
@@MaskST0 EQU 08h
@@MaskC EQU 0fh
FXAM
FSTSW AX
AND AH,NOT @@MaskST0
TEST AH,@@MaskC3
JZ @@1
OR AH,@@MaskST0
@@1:
AND AH,@@MaskC
MOV AL,AH
LEA BX,cxCTable
XLAT
ENDM
P8086
;----------------------------------------------------------------------
;function CTest87: Integer;
;checks numeric coprocessor
;returns AX = 80x87 flag as above
;----------------------------------------------------------------------
CTest87 PROC PASCAL FAR
LOCAL Tmp
XOR AX,AX ;indicate no 80x87
FNINIT ;initialize 80x87
MOV Tmp,0 ;clear status word
FNSTCW Tmp ;store status word
FWAIT
AND Tmp,0F3FH ;mask out unwanted bits
CMP Tmp,033FH ;compare to 80x87 default
JNE @@End
NOT Tmp
FLDCW Tmp
FSTCW Tmp
FWAIT
AND Tmp,0F3FH ;mask out unwanted bits
CMP Tmp,0C00H ;compare to 80x87 default
JNE @@End
PUSH SP ;check 8088/8086
POP AX
CMP AX,SP ;not equal on 8088/8086
MOV AX,1 ;indicate 8087
JNE @@End
FINIT ;initialize
FLD1 ;generate +INF
FLDZ
FDIV
FLD ST(0) ;generate -INF
FCHS
FCOMPP ;compare infinities
FSTSW Tmp ;store status
FWAIT
MOV AX,Tmp ;status to flags
SAHF
JNE @@387
MOV AX,2 ;indicate 80287
JMP SHORT @@End
@@387: MOV AX,3 ;indicate 80387
@@End:
RET
CTest87 ENDP
;----------------------------------------------------------------------
;function CInit: Integer;
;initializes complex math unit
;returns AX = 0 if Ok, AX <> 0 else
;----------------------------------------------------------------------
CInit PROC PASCAL FAR
LOCAL @@cx2:WORD
CALL CTest87 PASCAL
MOV cxx87,AX
CMP AX,cxx87Min
JGE @@Ok
MOV AX,1
JMP SHORT @@End
@@Ok:
cxInit
FLDPI
MOV @@cx2,2
FILD WORD PTR @@cx2
FDIV
FST QWORD PTR cxPI2
FILD WORD PTR @@cx2
FDIV
FSTP QWORD PTR cxPI4
cxLDj
cxSTP4 Cj
cxLD1
cxSTP4 C1
XOR AX,AX
@@End:
RET
CInit ENDP
P286
;----------------------------------------------------------------------
;function Cmplx(A, B: Double): Complex;
;makes complex from a and b
;returns ST = a + i * b
;----------------------------------------------------------------------
Cmplx PROC PASCAL FAR ;z := a + i * b
ARG A:QWORD, B:QWORD
FLD QWORD PTR A
FLD QWORD PTR B
cxCONV4 B
RET
Cmplx ENDP
;----------------------------------------------------------------------
;function CReal(Z: Complex): Double;
;real part from z = a + i * b
;returns ST = a
;----------------------------------------------------------------------
CReal PROC PASCAL FAR ;a
ARG Z:QWORD
FLD DWORD PTR Z
RET
CReal ENDP
;----------------------------------------------------------------------
;function CImag(Z: Complex): Double;
;imaginary part from z = a + i * b
;returns ST = b
;----------------------------------------------------------------------
CImag PROC PASCAL FAR ;b
ARG Z:QWORD
FLD DWORD PTR Z + 4
RET
CImag ENDP
;----------------------------------------------------------------------
;function Conjug(Z: Complex): Complex;
;conjugate complex for z = a + i * b
;returns ST = a - i * b
;----------------------------------------------------------------------
Conjug PROC PASCAL FAR ;a - i * b
ARG Z:QWORD
cxLD4 Z
cxCNJG
cxCONV4 Z
RET
Conjug ENDP
;----------------------------------------------------------------------
;function CAdd(Z, P: Complex): Complex;
;adds z = a + i * b and p = c + i * d
;returns ST = z + p
;----------------------------------------------------------------------
CAdd PROC PASCAL FAR ;z + p
ARG Z:QWORD, P:QWORD
cxLD4 Z
cxLD4 P
cxADD
cxCONV4 Z
RET
CAdd ENDP
;----------------------------------------------------------------------
;function CSub(Z, P: Complex): Complex;
;subtracts p = c + i * d from z = a + i * b
;returns ST = z - p
;----------------------------------------------------------------------
CSub PROC PASCAL FAR ;z - p
ARG Z:QWORD, P:QWORD
cxLD4 Z
cxLD4 P
cxSUB
cxCONV4 Z
RET
CSub ENDP
;----------------------------------------------------------------------
;function CMul(Z, P: Complex): Complex;
;multiplies z = a + i * b and p = c + i * d
;returns ST = z * p
;----------------------------------------------------------------------
CMul PROC PASCAL FAR ;z * p
ARG Z:QWORD, P:QWORD
cxLD4 P
cxLD4 Z
cxMUL
cxCONV4 Z
RET
CMul ENDP
;----------------------------------------------------------------------
;function CDiv(Z, P: Complex): Complex;
;divides z = a + i * b by p = c + i * d
;returns ST = z / p
;----------------------------------------------------------------------
CDiv PROC PASCAL FAR ;z / p
ARG Z:QWORD, P:QWORD
cxLD4 Z
cxLD4 P
cxDIV
cxCONV4 Z
RET
CDiv ENDP
;----------------------------------------------------------------------
;function C1Z(Z: Complex): Complex;
;divides 1 by z = a + i * b
;returns ST = 1 / z
;----------------------------------------------------------------------
C1Z PROC PASCAL FAR ;a - i * b
ARG Z:QWORD
cxLD4 Z
cx1Z
cxCONV4 Z
RET
C1Z ENDP
;----------------------------------------------------------------------
;function CAbs(Z: Complex): Complex;
;absolute value of complex z = a + i * b
;returns ST = abs(z) = a^2 + b^2
;----------------------------------------------------------------------
CAbs PROC PASCAL FAR ;abs(z)
ARG Z:QWORD
cxLD4 Z
cxABS
RET
CAbs ENDP
;----------------------------------------------------------------------
;function CArg(Z: Complex): Complex;
;argument of complex z = a + i * b
;returns ST = arg(z)
;----------------------------------------------------------------------
CArg PROC PASCAL FAR ;arg(z)
ARG Z:QWORD
cxLD4 Z
cxARG
RET
CArg ENDP
;----------------------------------------------------------------------
;function _CExpR(R: Double): Double;
;exponential of real r
;returns ST = e^r
;----------------------------------------------------------------------
_CExpR PROC PASCAL NEAR ;e^r
ARG R:QWORD
FLD QWORD PTR R
cxEXPR
RET
_CExpR ENDP
;----------------------------------------------------------------------
;function _CExp2(Z: Complex): Complex;
;exponential of complex z for 80287
;returns ST = e^z = e^a * (cos(b) + i * sin(b))
;----------------------------------------------------------------------
_CExp2 PROC PASCAL NEAR ;e^z
ARG Z:QWORD
LOCAL A:QWORD,B:QWORD,SinB:QWORD
cxLD4 Z
FSTP B
FSTP A
CALL NEAR PTR Sin PASCAL, DWORD PTR B[4] DWORD PTR B
FSTP QWORD PTR SinB
CALL NEAR PTR Cos PASCAL, DWORD PTR B[4] DWORD PTR B
FLD QWORD PTR SinB
FLD QWORD PTR A
cxEXPR
FMUL ST(2),ST
FMUL
cxCONV4 Z
RET
_CExp2 ENDP
;----------------------------------------------------------------------
;function _CExp3(Z: Complex): Complex;
;exponential of complex z for 80387
;returns ST = e^z = e^a * (cos(b) + i * sin(b))
;----------------------------------------------------------------------
P386
_CExp3 PROC PASCAL NEAR ;e^z
ARG Z:QWORD
cxLD4 Z
cxEXP3
cxCONV4 Z
RET
_CExp3 ENDP
;----------------------------------------------------------------------
;function CExp(Z: Complex): Complex;
;exponential of complex z
;returns ST = e^z = e^a * (cos(b) + i * sin(b))
;----------------------------------------------------------------------
P386
CExp PROC PASCAL FAR ;e^z
ARG Z:QWORD
CMP cxx87,2
JLE @@287
cxLD4 Z
cxEXP3
cxCONV4 Z
RET
@@287:
CALL NEAR PTR _CExp2 PASCAL, DWORD PTR Z[4] DWORD PTR Z
RET
CExp ENDP
;----------------------------------------------------------------------
;function CLn(Z: Complex): Complex;
;natural logarithm of complex z
;returns ST = ln(z) = ln(abs(z)) + i * arg(z)
;----------------------------------------------------------------------
P286
CLn PROC PASCAL FAR ;ln z
ARG Z:QWORD
cxLD4 Z
cxABS
cxLNR
cxLD4 Z
cxARG
cxCONV4 Z
RET
CLn ENDP
;----------------------------------------------------------------------
;function CPow(Z, P: Complex): Complex;
;complex z in complex power p
;returns ST = z^p = e^(p * ln(z))
;----------------------------------------------------------------------
P386
CPow PROC PASCAL FAR ;z^p
ARG Z:QWORD, P:QWORD
cxLD4 Z
cxABS
cxLNR
cxLD4 Z
cxARG
cxLD4 P
cxMUL
CMP cxx87,2
JLE @@287
cxEXP3
cxCONV4 Z
RET
@@287:
cxSTP4 Z
CALL NEAR PTR _CExp2 PASCAL, DWORD PTR Z[4] DWORD PTR Z
RET
CPow ENDP
;----------------------------------------------------------------------
;function CIPow(Z: Complex; N: Integer): Complex;
;complex z in integer power n
;returns ST = z^n
;performs consequent multiplication if abs(n) <= MaxMult,
; else uses z^n = abs(z)^n * (cos(n*arg(z)) + i * sin(n*arg(z)))
;----------------------------------------------------------------------
P386
CIPow PROC PASCAL FAR ;z^n
ARG Z:QWORD, N:WORD
LOCAL T:QWORD, SinT:QWORD
@@MaxMult EQU 16
MOV CX,N
XOR DL,DL
CMP CX,0
JG @@1
JL @@NLT0
cxLD1
JMP SHORT @@3
@@NLT0:
NEG CX
MOV N,CX
MOV DL,1
@@1:
CMP CX,@@MaxMult
JG @@AbsArg
cxLD4 Z
DEC CX
AND CX,CX
JZ @@2
@@Mul:
cxLD4 Z
cxMUL
LOOP @@Mul
@@2:
AND DL,DL
JZ @@3
cx1Z
@@3:
cxCONV4 Z
RET
@@AbsArg:
cxLD4 Z
cxARG
FILD WORD PTR N
FMUL
CMP cxx87,2
JLE @@287
FSINCOS
FXCH
JMP SHORT @@4
@@287:
FSTP T
CALL NEAR PTR Sin PASCAL, DWORD PTR T[4] DWORD PTR T
FSTP SinT
CALL NEAR PTR Cos PASCAL, DWORD PTR T[4] DWORD PTR T
FLD SinT
@@4:
FILD WORD PTR N
cxLD4 Z
cxABS
cxPOWR ;R^n
FMUL ST(2),ST
FMUL
JMP @@2
CIPow ENDP
;----------------------------------------------------------------------
;function CRPow(Z: Complex; R: Double): Complex;
;complex z in real power r
;returns ST = z^r = abs(z)^r * (cos(r*arg(z)) + i * sin(r*arg(z)))
;----------------------------------------------------------------------
P386
CRPow PROC PASCAL FAR ;z^r
ARG Z:QWORD, R:QWORD
LOCAL T:QWORD, CosT:QWORD
FLD R
XOR DL,DL
cxTST
JG @@1
JL @@RLT0
FSTP ST
JMP @@3
@@RLT0:
FCHS
MOV DL,1
@@1:
cxLD4 Z
cxARG
FLD ST(1) ;r
FMUL
CMP cxx87,2
JLE @@287
FSINCOS
JMP SHORT @@4
@@287:
FSTP T
CALL NEAR PTR Cos PASCAL, DWORD PTR T[4] DWORD PTR T
FSTP CosT
CALL NEAR PTR Sin PASCAL, DWORD PTR T[4] DWORD PTR T
FLD CosT
@@4:
FXCH ST(2) ;r
cxLD4 Z
cxABS
cxPOWR ;R^r
FMUL ST(2),ST
FMUL
AND DL,DL
JZ @@3
cx1Z
@@3:
cxCONV4 Z
RET
CRPow ENDP
;----------------------------------------------------------------------
;function CSinR(R: Double): Double;
;sine of real r
;returns ST = sin(r)
;----------------------------------------------------------------------
P386
CSinR PROC PASCAL FAR ;sin(r)
ARG R:QWORD
CMP cxx87,2
JLE @@287
FLD QWORD PTR R
FSIN
RET
@@287:
CALL NEAR PTR Sin PASCAL, DWORD PTR R[4] DWORD PTR R
RET
CSinR ENDP
;----------------------------------------------------------------------
;function CCosR(R: Double): Double;
;cosine of real r
;returns ST = cos(r)
;----------------------------------------------------------------------
P386
CCosR PROC PASCAL FAR ;cos(r)
ARG R:QWORD
CMP cxx87,2
JLE @@287
FLD QWORD PTR R
FCOS
RET
@@287:
CALL NEAR PTR Cos PASCAL, DWORD PTR R[4] DWORD PTR R
RET
CCosR ENDP
;----------------------------------------------------------------------
;function CCosR(R: Double; var S, C: Double): Double;
;sine and cosine of real r
;sets s := sin(r); c := cos(r)
;returns noting
;----------------------------------------------------------------------
P386
CSinCosR PROC PASCAL FAR ;sin(r) & cos(r)
ARG R:QWORD, S:DWORD, C:DWORD
CMP cxx87,2
JLE @@287
FLD QWORD PTR R
FSINCOS
LES BX,DWORD PTR C
LFS SI,DWORD PTR S
FSTP QWORD PTR ES:[BX]
FSTP QWORD PTR FS:[SI]
RET
@@287:
CALL NEAR PTR Sin PASCAL, DWORD PTR R[4] DWORD PTR R
LES BX,DWORD PTR S
FSTP QWORD PTR ES:[BX]
CALL NEAR PTR Cos PASCAL, DWORD PTR R[4] DWORD PTR R
LES BX,DWORD PTR C
FSTP QWORD PTR ES:[BX]
RET
CSinCosR ENDP
;----------------------------------------------------------------------
;function CTest(Z: Complex): Word;
;tests complex z
;returns AL = state of real part, AH = state of imag. part
;this function returns 80x87 register state flags
;----------------------------------------------------------------------
P286
CTest PROC PASCAL FAR
ARG Z:QWORD
cxLD4 Z
cxEXAM
FXCH
MOV DL,AL
cxEXAM
FCOMPP
MOV AH,DL
RET
CTest ENDP
;----------------------------------------------------------------------
;function CTestR(R: Double): Word;
;tests real r
;returns AX = state of real r
;this function returns 80x87 register state flags
;----------------------------------------------------------------------
P286
CTestR PROC PASCAL FAR
ARG R:QWORD
FLD R
cxEXAM
FSTP ST
XOR AH,AH
RET
CTestR ENDP
;----------------------------------------------------------------------
;function CCheck(Z: Complex): Word;
;checks complex z
;returns AX <> 0 if real or imag. part invalid (not a zero and
; not a normalized number)
;----------------------------------------------------------------------
P286
CCheck PROC PASCAL FAR
ARG Z:QWORD
FLD DWORD PTR Z
cxEXAM
AND AL,NOT OK87
JZ @@1
FSTP ST
RET
@@1:
FLD DWORD PTR Z + 4
cxEXAM
AND AL,NOT OK87
JNZ @@2
XOR AX,AX
@@2:
FCOMPP
RET
CCheck ENDP
;----------------------------------------------------------------------
;function CCheckR(R: Double): Word;
;tests real r
;returns AX <> 0 if real invalid (not a zero and not a normalized number)
;----------------------------------------------------------------------
P286
CCheckR PROC PASCAL FAR
ARG R:QWORD
FLD R
cxEXAM
FSTP ST
AND AL,NOT OK87
XOR AH,AH
RET
CCheckR ENDP
END